{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit MetaData;

interface

uses Classes, NameValues, MetaConsts;

const
  MAX_STACK_DEPTH = 5; // Maximum recursive stack depth for meta data def'ns

type
  TAHMMetaData = class(TAHMNameValueList)
  public
    destructor Destroy; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    function AddValue(const Name: String; Value: Boolean): Integer; overload;
    function AddValue(const Name: String; Value: Integer): Integer; overload;
    procedure Apply;
  end;

  TAHMNestedMetaData = class(TAHMMetaData)
  private
  protected
    procedure ApplyMetaData(Source: TAHMMetaData);
    function GetNameSpace(var Name: String; ReadOnly: Boolean = False): TAHMNestedMetaData;
  public
    function AddValue(const Name, Value: String): Integer; override;
    function AddObject(const Name: String; Value: TObject): Integer; override;
    function GetMetaValue(const Name: String): String;
    function GetMetaValues(const Name: String): TAHMNestedMetaData;
  end;

  TAHMMetaDataManager = class
  private
    FMetaData: TAHMNestedMetaData;
    FStackDepth: Integer;
  protected
    procedure InitialiseSystemValues;
    procedure PersistMetaValues;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ApplyMetaData(Source: TAHMMetaData);
    procedure SetMetaValue(Name, Value: String);
    procedure SetMetaWideValue(Name: String; Value: WideString);
    procedure SetMetaInteger(Name: String; Value: Integer);
    procedure SetMetaBoolean(Name: String; Value: Boolean);
    function GetMetaCount(Name: String): Integer;
    function GetMetaValue(Name: String): String;
    function GetMetaWideValue(Name: String): WideString;
    function GetMetaInteger(Name: String): Integer;
    function GetMetaBoolean(Name: String): Boolean;
    function GetMetaData(var Name: String): TAHMMetaData;
    function GetIndexedMetaValue(GroupName, ChildName: String; Index: Integer): String;
    function LookupMetaValue(Index: String; GroupName: String): String;
    function ProcessMarkup(Source: String): String;
    procedure ListMetaValues(Lines: TStrings; Prefix: String);
    procedure ClearMetaData(Name: String);
    procedure NextMeta(Item, GroupName: String);
    procedure PrevMeta(Item, GroupName: String);
    procedure IncMeta(Item, GroupName: String);
    procedure DecMeta(Item, GroupName: String);
  end;

implementation

uses SysUtils, StrUtils, Logging, Languages, ApplicationManager, Timing,
     Utilities, UniCode;


destructor TAHMMetaData.Destroy;
var
  i: Integer;
begin
  // Ensure we delete any contained meta objects
  for i := 0 to Pred(Count) do
    Objects[i].Free;

  inherited Destroy;
end;

procedure TAHMMetaData.Clear;
var
  i: Integer;
begin
  // Ensure we delete any contained meta objects
  for i := 0 to Pred(Count) do
    Objects[i].Free;

  inherited;
end;

procedure TAHMMetaData.Delete(Index: Integer);
begin
  // Ensure we delete any contained meta object
  Objects[Index].Free;

  inherited;
end;

function TAHMMetaData.AddValue(const Name: String; Value: Boolean): Integer;
begin
  if Value then Result := AddValue(Name, META_TRUE)
           else Result := AddValue(Name, META_FALSE);
end;

function TAHMMetaData.AddValue(const Name: String; Value: Integer): Integer;
begin
  Result := AddValue(Name, IntToStr(Value));
end;

procedure TAHMMetaData.Apply;
begin
  ApplicationManagerInstance.MetaDataManager.ApplyMetaData(Self);
end;

//----------------------------------------------------------------------------//

procedure TAHMNestedMetaData.ApplyMetaData(Source: TAHMMetaData);
var
  i: Integer;
begin
  BeginUpdate;
  try
    for i := 0 to Pred(Source.Count) do
      AddValue(Source[i], Source.Values[i]);
  finally
    EndUpdate;
  end;
end;

function TAHMNestedMetaData.GetNameSpace(var Name: String; ReadOnly: Boolean): TAHMNestedMetaData;
var
  iIndex: Integer;
  iPos: Integer;
  sPrefix: String;
  Namespace: TAHMNestedMetaData;
begin
  // Set default result - no namespace found
  Result := nil;
  Namespace := Self;

  // Parse first delimited section of name
  iPos := Pos(META_SEP, Name);

  // Parse each section of delimited name
  while iPos > 0 do
  begin
    // Name separator found, so we need to split prefix out
    sPrefix := Copy(Name, 1, Pred(iPos));
    Name := Copy(Name, Succ(iPos), Length(Name));

    if sPrefix <> '' then
    begin
      // Check whether we have already stored this namespace
      iIndex := Namespace.IndexOf(sPrefix);

      if iIndex = -1 then
      begin
        // Namespace doesn't exist yet, add it unless read only
        if ReadOnly then Exit
        else iIndex := NameSpace.AddObject(sPrefix, TAHMNestedMetaData.Create);
      end
      else if Namespace.Objects[iIndex] = nil then
      begin
        // Namespace only holds values, add nested data instance
        if ReadOnly then Exit
        else Namespace.Objects[iIndex] := TAHMNestedMetaData.Create;
      end;

      // We now know the index of the appropriate namespace object
      Namespace := TAHMNestedMetaData(Namespace.Objects[iIndex]);

      // Check again for delimiters in name
      iPos := Pos(META_SEP, Name);
    end
    else
      Break;
  end;

  // Return appropriate namespace
  Result := Namespace;
end;

function TAHMNestedMetaData.AddValue(const Name, Value: String): Integer;
var
  oMeta: TAHMNestedMetaData;
  sNameSpace: String;
begin
  // Get appropriate namespace for meta value
  sNameSpace := Name;
  oMeta := GetNameSpace(sNameSpace);

  // Add to self using inherited method, otherwise delegate to namespace
  if oMeta = Self then inherited AddValue(sNameSpace, Value)
                  else oMeta.AddValue(sNameSpace, Value);

  Result := IndexOf(sNameSpace);
end;

function TAHMNestedMetaData.AddObject(const Name: String; Value: TObject): Integer;
var
  oMeta: TAHMNestedMetaData;
  sNameSpace: String;
begin
  // Get appropriate namespace for meta value
  sNameSpace := Name;
  oMeta := GetNameSpace(sNameSpace);

  // Add to self using inherited method, otherwise delegate to namespace
  if oMeta = Self then inherited AddObject(sNameSpace, Value)
                  else oMeta.AddObject(sNameSpace, Value);

  Result := IndexOf(sNameSpace);
end;

function TAHMNestedMetaData.GetMetaValue(const Name: String): String;
var
  oMeta: TAHMNestedMetaData;
  sNameSpace: String;
  i: Integer;
begin
  // Get appropriate namespace for meta value
  sNameSpace := Name;
  oMeta := GetNameSpace(sNameSpace, True);

  if oMeta = nil then
  begin
    // Namespace not found, so we didn't create it
    Result := '';
  end
  else
  begin
    // Check for special case of count or indexed value
    if sNameSpace = META_COUNT then
      Result := IntToStr(oMeta.Count) // count
    else if Copy(Name, 1, Length(META_INDEX)) <> META_INDEX then
      Result := oMeta.GetValue(sNameSpace) // regular string value
    else
    begin
      // indexed value - get index and check range
      i := StrToIntDef(sNameSpace, -1);
      if (i >= 0) and (i < oMeta.Count) then
        Result := oMeta.Values[i]
      else
        Result := '';
    end;
  end;
end;

function TAHMNestedMetaData.GetMetaValues(const Name: String): TAHMNestedMetaData;
var
  sNameSpace: String;
  i: Integer;
begin
  // Get appropriate namespace for meta value
  sNameSpace := Name;
  Result := GetNameSpace(sNameSpace);

  // We now need to find object corresponding to last part of name
  i := Result.IndexOf(sNameSpace);
  if i < 0 then
    Result := nil
  else if Result.Objects[i] is TAHMNestedMetaData then
    Result := TAHMNestedMetaData(Result.Objects[i])
  else
    Result := nil;
end;

//----------------------------------------------------------------------------//

constructor TAHMMetaDataManager.Create;
begin
  inherited Create;

  FMetaData := TAHMNestedMetaData.Create;
  InitialiseSystemValues;
end;

destructor TAHMMetaDataManager.Destroy;
begin
  // Persist meta values just before we are destroyed
  PersistMetaValues;
  FMetaData.Free;

  inherited Destroy;
end;

procedure TAHMMetaDataManager.InitialiseSystemValues;
begin
  // Add static system data values to application meta list
  FMetaData.AddValue(META_APPNAME, 'mediate');
  FMetaData.AddValue(META_APPURL, ApplicationURL);
  FMetaData.AddValue(META_APPVER, ApplicationVersion);

  // Add static values with runtime translation to current language
  FMetaData.AddValue(META_BOOLEANS_TRUE, META_MARKER + META_TEXT_BEG + META_BOOLEANS_YES + META_TEXT_END);
  FMetaData.AddValue(META_BOOLEANS_FALSE, META_MARKER + META_TEXT_BEG + META_BOOLEANS_NO + META_TEXT_END);
  FMetaData.AddValue(META_BOOLEAN_TEST, True);

  // Add initial values for date/time
  FMetaData.AddValue(META_APPTIME, TimerInstance.CurrentTime);
  FMetaData.AddValue(META_APPDATE, TimerInstance.CurrentDate);

  // Add initial values for debug settings
  FMetaData.AddValue(META_DEBUG_PERSPECTIVE, True);
  FMetaData.AddValue(META_DEBUG_BORDERS, False);

{$IFDEF DESIGNER}
  // Add sample metadata for designer preview controls
  FMetaData.AddValue(META_PREVIEW_BAR_VALUE, 50);
  FMetaData.AddValue(META_PREVIEW_BAR_MAX, 100);
  FMetaData.AddValue(META_PREVIEW_GAUGE_VALUE, 0);
  FMetaData.AddValue(META_PREVIEW_GAUGE_MAX, 360);
  FMetaData.AddValue(META_PREVIEW_DIAL_VALUE, 0);
  FMetaData.AddValue(META_PREVIEW_DIAL_MAX, 360);
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [0]), 'Lorem ipsum');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [1]), 'dolor sit amet');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [2]), 'consectetur');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [3]), 'adipisicing elit');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [4]), 'sed do eiusmod');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [5]), 'tempor incididunt');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [6]), 'ut labore et dolore');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [7]), 'magna aliqua');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [8]), 'Ut enim ad minim veniam');
  FMetaData.AddValue(Format(META_PREVIEW_GRID_ITEM, [9]), 'quis nostrud');
{$ENDIF}
end;

procedure TAHMMetaDataManager.PersistMetaValues;
var
  Prefix: String;
  Values: TAHMMetaData;
begin
  // Get current values in 'persist' namespace
  Prefix := META_PERSIST;
  Values := FMetaData.GetMetaValues(Prefix);

  // Replace current values within persisted metadata list
  ApplicationManagerInstance.StateManager.MetaSettings.ClearObjects;
  ApplicationManagerInstance.StateManager.MetaSettings.ReadValues(Prefix, Values);
end;

procedure TAHMMetaDataManager.ApplyMetaData(Source: TAHMMetaData);
begin
  FMetaData.ApplyMetaData(Source);
end;

procedure TAHMMetaDataManager.SetMetaValue(Name, Value: String);
begin
  // Add/Update name value pair in meta data list
  FMetaData.AddValue(Name, Value);
end;

procedure TAHMMetaDataManager.SetMetaWideValue(Name: String; Value: WideString);
begin
  // Encode value using UTF8 and store it
  SetMetaValue(Name, EncodeWideString(Value));
end;

procedure TAHMMetaDataManager.SetMetaInteger(Name: String; Value: Integer);
begin
  // Add/Update integer metadata value
  FMetaData.AddValue(Name, Value);
end;

procedure TAHMMetaDataManager.SetMetaBoolean(Name: String; Value: Boolean);
begin
  // Add/Update boolean metadata value
  FMetaData.AddValue(Name, Value);
end;

function TAHMMetaDataManager.GetMetaCount(Name: String): Integer;
begin
  // Get count of child metadata items
  Result := StrToIntDef(GetMetaValue(Name + META_SEP + META_COUNT), 0);
end;

function TAHMMetaDataManager.GetMetaValue(Name: String): String;
begin
  // Lookup value in list of static meta values first
  Result := FMetaData.GetMetaValue(Name);

  // Process markup content within meta value
  if Pos(META_MARKER, Result) > 0 then
    Result := ProcessMarkup(Result);
end;

function TAHMMetaDataManager.GetMetaWideValue(Name: String): WideString;
begin
  // Unravel UTF8 encoding of stored value
  Result := DecodeWideString(GetMetaValue(Name));
end;

function TAHMMetaDataManager.GetMetaInteger(Name: String): Integer;
begin
  // Convert metavalue to integer
  Result := StrToIntDef(GetMetaValue(Name), 0);
end;

function TAHMMetaDataManager.GetMetaBoolean(Name: String): Boolean;
var
  Value: String;
begin
  // Convert metavalue to boolean
  Value := GetMetaValue(Name);
  Result := (Value = META_TRUE) or (Value = META_BOOL_YES);
end;

function TAHMMetaDataManager.GetMetaData(var Name: String): TAHMMetaData;
begin
  Result := FMetaData.GetMetaValues(Name);
end;

function TAHMMetaDataManager.GetIndexedMetaValue(GroupName, ChildName: String; Index: Integer): String;
begin
  // Return indexed metadata child value
  Result := GetMetaValue(GroupName + META_SEP + META_INDEX + IntToStr(Index) + META_SEP + ChildName);
end;

function TAHMMetaDataManager.LookupMetaValue(Index: String; GroupName: String): String;
begin
  Result := GetMetaValue(GroupName + META_SEP + Index);
end;

function TAHMMetaDataManager.ProcessMarkup(Source: String): String;
type
  ParsingState = (psSeek, psBegin, psMeta, psText, psExp);
var
  OldState, State: ParsingState;
  iPos, iBeg: Integer;
  sName: String;
begin
  // Check for excessively recursive markup definitions
  if FStackDepth > MAX_STACK_DEPTH then
  begin
    Result := 'Recursive metadata definition: ' + Source;
    Exit;
  end;

  // Increment stack depth whilst busy to avoid potential recursion
  Inc(FStackDepth);
  try
    // Set default result - empty string
    Result := '';

    // Initialise parsing state
    iPos := 1;
    iBeg := 0; // fix compiler warning
    State := psSeek;

    // Nibble along source string looking for markup indicators
    while iPos <= Length(Source) do
    begin
      // Preserve previous parsing state
      OldState := State;

      // Check for special case chars to switch states
      case Source[iPos] of
        META_MARKER:
        begin
          // Found a start marker - we now want to find markup type
          State := psBegin;
          iBeg := iPos;
        end;
        META_BEGIN: if OldState = psBegin then State := psMeta;
        META_EXP_BEG: if OldState = psBegin then State := psExp;
        META_TEXT_BEG: if OldState = psBegin then State := psText;
        META_END: if OldState = psMeta then
        begin
          // Substitute named meta value
          sName := Copy(Source, iBeg + 2, iPos - iBeg - 2);
          Result := Result + GetMetaValue(sName);
          State := psSeek;
        end;
        META_EXP_END: if OldState = psExp then
        begin
          // Substitute named expression value
          sName := Copy(Source, iBeg + 2, iPos - iBeg - 2);
          Result := Result + ApplicationManagerInstance.ExpressionManager.Evaluate(sName);
          State := psSeek;
        end;
        META_TEXT_END: if OldState = psText then
        begin
          // Substitute named text value
          sName := Copy(Source, iBeg + 2, iPos - iBeg - 2);
          Result := Result + LanguageManagerInstance.Translate(sName);
          State := psSeek;
        end;
      end;

      if (OldState = psBegin) and (State = psBegin) then
      begin
        // Didn't find meta marker after start indicator
        if Source[iPos] <> META_MARKER then State := psSeek;
        Result := Result + Source[iPos - 1];
        OldState := psSeek;
      end;

      if (OldState = psSeek) and (State = psSeek) then
      begin
        // Append standard character to result
        Result := Result + Source[iPos];
      end;

      Inc(iPos);
    end;
  finally
    Dec(FStackDepth);
  end;
end;

procedure TAHMMetaDataManager.ListMetaValues(Lines: TStrings; Prefix: String);
begin
  // If no prefix entered then just show root items, if a single item specified
  // then just return that with its value, but if a valid prefix was entered
  // show the subtree of values from that point
  if Prefix = '' then
    FMetaData.WriteValues(Lines)
  else if (RightStr(Prefix, 1) <> META_SEP) then
    Lines.Add(Prefix + '=' + GetMetaValue(Prefix))
  else
   FMetaData.GetNameSpace(Prefix).WriteValues(Lines);
end;

procedure TAHMMetaDataManager.ClearMetaData(Name: String);
var
  oMeta: TAHMNestedMetaData;
  sNameSpace: String;
  i: Integer;
begin
  // Get appropriate namespace for meta value
  sNameSpace := Name;
  oMeta := FMetaData.GetNameSpace(sNameSpace);

  // If we found specified value then delete it
  if Assigned(oMeta) then
  begin
    i := oMeta.IndexOf(sNameSpace);
    if i >= 0 then oMeta.Delete(i);
  end;
end;

procedure TAHMMetaDataManager.NextMeta(Item, GroupName: String);
var
  Values: TAHMMetaData;
  Value: String;
  i: Integer;
begin
  Values := GetMetaData(GroupName);
  Value := GetMetaValue(Item);
  if Assigned(Values) and (Values.Count > 0) then
  begin
    i := Values.IndexOf(Value);

    // If item not initialised, then select 2nd item in list to avoid check
    // and combo controls without initialised metadata requiring two clicks
    if (i < 0) and (Values.Count > 1) then Value := Values.Names[1]
    else if (i >= 0) and (i < Pred(Values.Count)) then Value := Values.Names[Succ(i)]
    else Value := Values.Names[0];

    // Store new metadata value
    SetMetaValue(Item, Value);
  end
  else
    LogWarn('Can''t select next metadata item for unknown meta group: ' + GroupName);
end;

procedure TAHMMetaDataManager.PrevMeta(Item, GroupName: String);
var
  Values: TAHMMetaData;
  Value: String;
  i: Integer;
begin
  Values := GetMetaData(GroupName);
  Value := GetMetaValue(Item);
  if Assigned(Values) and (Values.Count > 0) then
  begin
    i := Values.IndexOf(Value);

    // Select previous item. If not found or we loop then select last item
    if (i <= 0) then Value := Values.Names[Pred(Values.Count)]
                else Value := Values.Names[Pred(i)];

    // Store new metadata value
    SetMetaValue(Item, Value);
  end
  else
    LogWarn('Can''t select previous metadata item for unknown meta group: ' + GroupName);
end;

procedure TAHMMetaDataManager.IncMeta(Item, GroupName: String);
var
  Value, Max: Integer;
begin
  Value := GetMetaInteger(Item);
  Max := GetMetaInteger(GroupName);

  // Increment Value so long as it doesn't exceed Max
  if ((Max > 0) and (Value < Max)) or ((Max < 0) and (Max < 0)) then Inc(Value);

  // Store new metadata value
  SetMetaInteger(Item, Value);
end;

procedure TAHMMetaDataManager.DecMeta(Item, GroupName: String);
var
  Value, Max: Integer;
begin
  Value := GetMetaInteger(Item);
  Max := GetMetaInteger(GroupName);

  // Decrement Value so long as it doesn't exceed Min
  if ((Max > 0) and (Value > 0)) or ((Max < 0) and (Value > Max)) then Dec(Value);

  // Store new metadata value
  SetMetaInteger(Item, Value);
end;


end.
